home *** CD-ROM | disk | FTP | other *** search
/ AMOS PD CD / amospdcd.iso / sourcecode / general / pixel packer.amos / pixel packer.amosSourceCode
Encoding:
AMOS Source Code  |  1978-01-12  |  3.4 KB  |  113 lines
  1. 'Pixel Packer PAL v1.0 
  2. '
  3. 'Written by Wai Hung Liu on the 16-7-91 with AMOS Basic v1.3 
  4. 'This is only the 2nd day since I bought AMOS so I'm sorry if use of some
  5. 'of the commands are vague. I promise future versions are better. You can
  6. 'unfold the procedures to customise destination banks, etc. I hope you find
  7. 'this program useful. Thanks to Francois Lionet for writing AMOS.
  8. 'When loading/saving banks please wait for de/compression! 
  9. '
  10. 'This version as far as I know in AMOS Basic v1.3 handles :-   
  11. '
  12. 'Low, Medium, and High resolutions, with Overscan, Interlace, or both
  13. '2,4,8,16,32,64,and 4096 Colours (Sorry! No 24 Bit true colour images!)  
  14. 'NTSC or PAL pictures, or even IFF Brushes 
  15. 'IFF ILBM, DPaint Compressed, Amos Compressed, Spacked Bank or even a
  16. 'Binary version of the Spacked Bank, plus all IFF art packages accepted  
  17. '
  18. Global FLAG,S$,L$,STYPE,LTYPE,MEMSIZE
  19. STYPE=0 : LTYPE=0 : MEMSIZE=65000
  20. SET_UP
  21. CREDITS
  22. SET_MENUS
  23. On Menu Proc ACTION
  24. On Menu On 
  25. Do 
  26. Loop 
  27. Procedure ACTION
  28.    If Choice
  29.       If Choice(2)=1
  30.          Screen Close 0 : SET_UP : CREDITS
  31.       End If 
  32.       If Choice(2)=2
  33.          LTYPE=Choice(3) : LGFX
  34.       End If 
  35.       If Choice(2)=3 and Choice(3)<>0
  36.          STYPE=Choice(3) : SGFX
  37.       End If 
  38.       If Choice(2)=4
  39.          Erase 1 : Rainbow 0,0,0,0 : Screen Close 0 : Menu Off : End 
  40.       End If 
  41.    End If 
  42.    On Menu On 
  43.    If FLAG<>1 Then Rainbow 0,0,40,260
  44. End Proc
  45. Procedure SET_UP
  46.    Screen Open 0,640,260,4,Hires
  47.    Curs Off : Flash Off : Colour 1,$0
  48.    Set Rainbow 0,1,30,"(1,1,15)(1,-1,15)","","(1,1,15)(1,-1,15)"
  49.    Rainbow 0,0,40,260
  50.    FLAG=0
  51. End Proc
  52. Procedure CREDITS
  53.    Locate ,14
  54.    Centre "Pixel Packer PAL v1.0"
  55.    Locate ,16
  56.    Centre "By Wai Hung Liu"
  57.    Locate ,17
  58.    Centre "Written with AMOS v1.3 on 16-7-1991"
  59.    Locate ,18
  60.    Centre "This piece of software is Public Domain"
  61.    Locate ,19
  62.    Centre "and may be freely redistrubuted!"
  63. End Proc
  64. Procedure SET_MENUS
  65.    Menu$(1)="Project"
  66.    Menu$(1,1)="Clear  "
  67.    Menu$(1,2)="Load   "
  68.    Menu$(1,3)="Save as"
  69.    Menu$(1,4)="Quit   "
  70.    Menu$(1,2,1)="Bank       "
  71.    Menu$(1,2,2)="Binary Bank"
  72.    Menu$(1,2,3)="IFF        "
  73.    Menu$(1,3,1)="Bank          "
  74.    Menu$(1,3,2)="Binary Bank   "
  75.    Menu$(1,3,3)="IFF Compressed"
  76.    Menu$(1,3,4)="IFF ILBM      "
  77.    Menu Static(1,1) : Menu Static(1,2,1) : Menu Static(1,3,1)
  78.    Menu On 
  79. End Proc
  80. Procedure LGFX
  81.    Rainbow 0,0,0,0
  82.    If LTYPE=1 Then PRE$="*.ABK" : A$="Load a Bank"
  83.    If LTYPE=2 Then PRE$="*.BIN" : A$="Load a Binary Bank"
  84.    If LTYPE=3 Then PRE$="" : A$="Load an IFF File"
  85.    L$=Fsel$(PRE$,"",A$)
  86.    If L$="" Then Pop Proc
  87.    If Exist(L$)
  88.       If LTYPE=1
  89.          Reserve As Data 1,MEMSIZE : Load L$,1 : FLAG=1
  90.          Unpack 1 To 0 : Erase 1
  91.       End If 
  92.       If LTYPE=2
  93.          Reserve As Data 1,MEMSIZE : Bload L$,1 : FLAG=1
  94.          Unpack 1 To 0 : Erase 1
  95.       End If 
  96.       If LTYPE=3
  97.          Load Iff L$,0 : FLAG=1
  98.       End If 
  99.    End If 
  100. End Proc
  101. Procedure SGFX
  102.    If FLAG=0 Then Pop Proc
  103.    If STYPE=1 Then PRE$="*.ABK" : A$="Save as Bank"
  104.    If STYPE=2 Then PRE$="*.BIN" : A$="Save as Binary Bank"
  105.    If STYPE=3 Then PRE$="" : A$="Save as IFF Compressed"
  106.    If STYPE=4 Then PRE$="" : A$="Save as IFF ILBM Picture"
  107.    S$=Fsel$(PRE$,"",A$)
  108.    If S$="" Then Pop Proc
  109.    If STYPE=1 Then Spack 0 To 1 : Save S$,1 : Erase 1
  110.    If STYPE=2 Then Spack 0 To 1 : Bsave S$,Start(1) To Start(1)+Length(1) : Erase 1
  111.    If STYPE=3 Then Save Iff S$,1
  112.    If STYPE=4 Then Save Iff S$,0
  113. End Proc